home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0033_Improved Graphics Rountines Part 1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  49.0 KB  |  1,988 lines
  1. (*
  2. PART 1 OF NEWGRAPH.PAS
  3. APPEND NEWGRPH2.PAS TO THE BOTTOM OF THIS FILE AND SAVE THE
  4. COMBINED FILES AS NEWGRAPH.PAS - COMPILE NEWGRAPH.PAS AND
  5. NOW SEE HOW MUCH FASTER AND MORE COMPLETE IT IS THAN ALL OF 
  6. THE OTHER SWAG GRAPHIC & SPRITE UNITS.
  7.  
  8.  
  9. **************************************************************
  10. NEWGRAPH! The (now slightly outdated) 320 x 200 x 256 VGA MODE
  11. SUPPORT UNIT by Scott Tunstall (C) 1994, 1996. (Rev 1. created
  12. in 1994, Final rev. Sept 1995)
  13.  
  14. Next project : This package converted to support VESA 16.7
  15.                Million Colour graphic modes. (That'll be a
  16.                task and a half)
  17.  
  18. After that   : Sleep for a year!!!
  19.  
  20. **************************************************************
  21.  
  22. READ THE DISCLAIMER FIRST BEFORE DOING ANYTHING!!!
  23.  
  24.  
  25.  
  26.  
  27. Purpose of unit
  28. ---------------
  29. The purpose of this unit is to provide an all-in-one package to
  30. allow you to write FAST games in Turbo Pascal.
  31.  
  32. The unit incorporates :
  33.  
  34.          o Easy bitmap initialisation and manipulation routines
  35.  
  36.          o The fastest masked/unmasked/clipped sprite graphics
  37.            routines you will EVER see for a 386/486 processor.
  38.  
  39.          o Easy to use palette routines (Not as many as I would
  40.            have liked to have included but there are 100s of
  41.            them available in the public domain - feel free to
  42.            use em if ya like.)
  43.  
  44.          o Font load/save/display routines which are also the
  45.            fastest you'll see (in 1994).
  46.  
  47.          o Versatile PCX load routines which can handle page sizes
  48.            up to 320 x 200 (Handy for grabbing sprites.)
  49.  
  50.  
  51. ALL time critical routines (i.e. Sprite drawing, Bitmap copying)
  52. are written in 100% assembly language and have all been tested
  53. extensively. (Yes Ronny I did write the assembler)
  54.  
  55. So in other words your machine shouldn't bomb when you use this unit!
  56. (See Disclaimer)
  57.  
  58. Any drawbacks ?
  59.  
  60. Err.. unfortunately (due to the limitations of Pascal's 286
  61. restrictions) you can't have a bitmap that exceeds 64K - yes
  62. I know this sucks but huge pointers don't exist in Pascal!!
  63.  
  64. The speed in some areas isn't as fast as it could be.. shit!!
  65. So, I am considering writing a version of this unit which does
  66. not use standard Pascal "stack frames" (Where Procedure parameters are
  67. moved to) but instead requires registers to be set on entry (about
  68. 100% faster).
  69.  
  70. But this will all be done once me B.Sc is over.
  71.  
  72.  
  73. THE DISCLAIMER
  74. --------------
  75.  
  76. Scott Tunstall (Me), the programmer of this pascal source and hence unit
  77. cannot be held responsible if ANY damage, be it physical or otherwise, to
  78. your system/peripherals etc. occurs from use/misuse of the code
  79. and/or unit. (Not that this unit uses any system-unfriendly hack
  80. tricks..)
  81.  
  82. You can distribute this unit UNALTERED and it would be nice if you
  83. mentioned me in any software you create with this unit.
  84.  
  85. Feel free to add parts to the unit. If any good, please post em to the SWAG 
  86. and let everyone see them. However, I would prefer to see ASM stuff be added
  87. instead of plain vanilla pascal.
  88.  
  89.  
  90. Name    : Scott Tunstall
  91. Address : 40 leadside crescent, Fife, Scotland.
  92.  
  93.  
  94. Minimum System requirements
  95. ---------------------------
  96. Turbo Pascal 6 - (Mind and check some of the "switches" below ).
  97. TP7 recommended though.
  98.  
  99. 386 processor.
  100. VGA graphics card that supports mode 13h and the 262,144
  101.     colour palette.
  102.  
  103.  
  104.  
  105. CONTACT: CG93SAT@IBMRISC.DCT.AC.UK (Up till June 15 1996)
  106. *)
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115. { You may have to remove some of these switches if using TP6.
  116.   Turbo 7 really is the bees knees (?) when it comes to software
  117.   development, laddie.
  118.  }
  119.  
  120. {$A+,B-,E+,F-,G+,N+,Q-,R-,S-}
  121.  
  122. UNIT NEWGRAPH;
  123.  
  124. INTERFACE
  125.  
  126. Const
  127.       GetMaxX                 = 319;    { Maximum X & Y coordinates }
  128.       GetMaxY                 = 199;
  129.       GetMaxColour             = 255;
  130.       MaxColours               = 256;
  131.  
  132.       Int1fFont               = 0;
  133.       Int43Font               = 1;
  134.       StandardVGAFont         = 1;
  135.       Font8x8                 = 1;      { Why do I get a "Constant Out
  136.                                         of range error" with this ? }
  137.       Font8x14                = 2;
  138.       Font8x8dd               = 3;      { Abbreviated }
  139.       Font8x8ddHigh           = 4;
  140.       AlphaAlternateFont      = 5;
  141.       FontAlpha               = 5;
  142.       Font8x16                = 6;
  143.       Font9x16                = 7;      { This doesn't appear, though }
  144.       FontRomAlt              = 7;      { it may just be my VGA }
  145.  
  146.  
  147. {
  148. This record is used to hold a screen/PCX's palette.
  149. }
  150.  
  151. TYPE
  152. PaletteType = record
  153.    RedLevel:   Array[0..MaxColours-1] of byte;
  154.    GreenLevel: Array[0..MaxColours-1] of byte;
  155.    BlueLevel:  Array[0..MaxColours-1] of byte;
  156. end;
  157.  
  158.  
  159.  
  160.  
  161. {
  162. This record is used to hold a Font's details, if you didn't guess
  163. that already ;-)
  164. }
  165.  
  166.  
  167. FontType = record
  168.    FontSeg       : Word;           { Where Font is located }
  169.    FontOfs       : Word;
  170.    FontWidth     : Byte;           { Width (In Pixels) }
  171.    FontByteWidth : Byte;           { Pixel width divided by 8 }
  172.    FontHeight    : Byte;           { Height (In Pixels) }
  173.    FontChars     : Byte;           { Number of characters in Font }
  174. End;
  175.  
  176.  
  177.  
  178.  
  179. { Jump into Mode 13h }
  180.  
  181. Procedure InitVGAMode;
  182.  
  183. {
  184. Bitmap initialisation and manipulation routines.
  185. }
  186.  
  187. Procedure Bitmap(Var BmapSegment,BmapOffset:word);
  188. Procedure FreeBitmap(BmapSegment,BmapOffset:word);
  189. Procedure ShowBitmap(BmapSegment,BmapOffset:word);
  190. Procedure GetSourceBitmapAddr(VAR SourceSeg,SourceOfs: word);
  191. Procedure SetSourceBitmapAddr(NewSourceSeg,NewSourceOfs:word);
  192. Procedure GetDestinationBitmapAddr(VAR DestinationSeg,DestinationOfs: word);
  193. Procedure SetDestinationBitmapAddr(NewDestinationBitmapSeg,NewDestinationBitmapOfs:word);
  194. Procedure CopySourceBitmap;
  195. Procedure OverlaySourceBitmap;
  196. Procedure DoubleBufferOff;
  197.  
  198.  
  199. { Drawing primitives }
  200.  
  201. Procedure PutPixel(x, y : integer; ColourValue : Byte);
  202. Function  GetPixel(X,Y: integer): integer;
  203. Procedure Line(X1, Y1, X2, Y2:integer);
  204. Procedure LineRel(DiffX,DiffY: integer);
  205. Procedure LineTo(Endx,Endy:integer);
  206. Procedure Rectangle(x1,y1,x2,y2:integer);
  207. Procedure MoveTo(NewCursX,NewCursY:integer);
  208. Function  GetX: integer;
  209. Function  GetY: integer;
  210. Procedure OutTextXY(x,y:integer; txt:string);
  211. Procedure OutText(txt:string);
  212.  
  213.  
  214. { Palette stuff }
  215.  
  216. Procedure SetColour(NewColour:byte);
  217. Function  GetColour: byte;
  218. Procedure GetPalette(ColourNumber : Byte; VAR RedValue, GreenValue, BlueValue : Byte);
  219. Procedure SetPalette(ColourNumber, RedValue, GreenValue, BlueValue : Byte);
  220. Procedure LoadPalette(FileName: String; Var Palette : PaletteType);
  221. Procedure SavePalette(FileName: String; Palette : PaletteType);
  222. Procedure GetAllPalette(Var Palette : PaletteType);
  223. Procedure SetAllPalette(Palette : PaletteType);
  224.  
  225.  
  226. {
  227. Fast sprite (shape) routines.
  228. }
  229.  
  230.  
  231. Procedure GetAShape(x1,y1,x2,y2:word;Var DataPtr);
  232. Procedure FreeShape(DataPtr:pointer);
  233. Procedure Blit(x,y:word; Var DataPtr);
  234. Procedure ClipBlit(x,y:integer; Var DataPtr);
  235. Procedure Block(x,y:word; Var DataPtr);
  236. Procedure ClipBlock(x,y:integer; Var DataPtr);
  237. Function  BlitColl(x,y :integer; Var dataptr) : boolean;
  238. Function  ShapeSize(x1,y1,x2,y2:word):word;
  239. Function  ExtShapeSize(ShapeWidth, ShapeHeight : byte): word;
  240. Function  ShapeWidth(Var DataPtr): byte;
  241. Function  ShapeHeight(Var DataPtr): byte;
  242. Procedure LoadShape(FileName:String; Var DataPtr:Pointer);
  243. Procedure SaveShape(FileName:string; DataPtr:Pointer);
  244.  
  245.  
  246. {
  247. Custom Font routines. Unfortunately, I don't know how to load
  248. in Windows bitmapped Fonts which is a real bast..
  249.  
  250. }
  251.  
  252. Procedure UseFont(FontNumber:byte);
  253. Function  GetROMCharOffset(CharNum:byte): word;
  254. Procedure GetCurrentFontAddr(VAR FontSeg,FontOfs:word);
  255. Procedure SetCurrentFontAddr(NewFontSeg,NewFontOfs:word);
  256. Procedure GetCurrentFontSize(Var CurrFontWidth, CurrFontHeight:byte);
  257. Procedure SetCurrentFontSize(NewFontWidth, NewFontHeight:byte);
  258. Procedure LoadFont(FontFileName:String; Var FontRec: FontType);
  259. Procedure UseLoadedFont(FontRec : FontType);
  260. Procedure SaveFont(FontFileName:String; FirstChar, Numchars:byte);
  261.  
  262.  
  263. {
  264. Can't include a GIF loader.. Compuserve don't like people using
  265. their GIF datatype without paying a small fee.. :(
  266. }
  267.  
  268. Procedure LoadPCX(FileName:string; Var ThePalette: PaletteType);
  269. Procedure LocatePCX(filename:string; Var ThePalette: PaletteType;
  270.           x,y,widthtoshow,heighttoshow:word);
  271. Procedure SavePCX(filename:string;ThePalette: PaletteType);
  272. Procedure SaveAreaAsPCX(filename:string;ThePalette: PaletteType;
  273.           x,y, PCXWidth,PCXHeight: word);
  274.  
  275.  
  276. {
  277. Miscellaneous useful routines.
  278. }
  279.  
  280. Procedure Vwait(TimeOut:word);
  281. Procedure Cls;
  282. Procedure CCls(TheColour : byte);
  283.  
  284.  
  285.  
  286.  
  287. IMPLEMENTATION
  288.  
  289.  
  290. Uses CRT,Dos;
  291.  
  292.  
  293. {
  294. This ** structure ** was nicked from READPCX.PAS that's currently
  295. in the SWAG. Credit to Norman Yen for writing a PCX loader program,
  296. it was very useful for understanding the PCX compression.
  297.  
  298. But my version of the PCX loader (rewritten from scratch) is faster
  299. (and better) than Norm's effort. And what's more it can handle Mode 13h
  300. PCX's of any size up to 320 x 200 pixels.
  301.  
  302. }
  303.  
  304. type Pcxheader_rec=record               { EXPECTED VALUES / COMMENTS}
  305.                                         { --------------------------}
  306.      manufacturer: byte;                { 10. (Why does Z-Soft have
  307.                                           this field ?) }
  308.      version: byte;                     { 5. }
  309.      encoding: byte;                    { 0.  (RLE PCX encryption) }
  310.      bits_per_pixel: byte;              { 8.  (8 bits = 256 colours) }
  311.      xmin, ymin: word;                  { 0,0 (Top Left) }
  312.      xmax, ymax: word;                  { 319,199 (Bottom right) }
  313.      hres: word;                        { 320 (although this (and vres)
  314.                                           may be ignored by some
  315.                                           programs)}
  316.      vres: word;                        { 200 }
  317.      palette: array [0..47] of byte;    { Don't use }
  318.      reserved: byte;                    { Don't use }
  319.      colour_planes: byte;               { 0 (Mode 13h is not planar) }
  320.      bytes_per_line: word;              { 320 (usually, may differ -
  321.                                           although I hear this should
  322.                                           be an even number my PCX load
  323.                                           /save routines work with odd
  324.                                           numbers too) }
  325.      palette_type: word;                { 12 (to work with this unit) }
  326.      filler: string[58];                { Don't know the purpose of this,
  327.                                           could it be for comments etc ? }
  328. end;
  329.  
  330.  
  331.  
  332. {
  333. ****************
  334. Variable section
  335. ****************
  336.  
  337. Note : You could make these public variables and that would probably
  338. increase the speed of your programs as you can access the data
  339. directly (via assembler, for example) instead of using the
  340. Setxxx() Procedures.
  341. }
  342.  
  343. Var
  344.     SourceBitmapSegment:          word;
  345.     SourceBitmapOffset:           word;
  346.     DestinationBitmapSegment:     word;
  347.     DestinationBitmapOffset:      word;
  348.  
  349.     CurrentFontSegment:         word;
  350.     CurrentFontOffset:          word;
  351.     CurrentFontWidth:           byte;
  352.     CurrentFontByteWidth:       byte;
  353.     CurrentFontHeight:          byte;
  354.     CurrentColour:               byte;
  355.     CursorX:                    integer;
  356.     CursorY:                    integer;
  357.  
  358.     header:                     Pcxheader_rec;
  359.  
  360.  
  361.  
  362.  
  363. (*
  364. This routine has nothing to do with graphics - it just helps
  365. with some routines.
  366.  
  367. Expects : PT is a standard pointer.
  368.           Segm and Offs are uninitialised word variables.
  369.  
  370. Returns : On exit Segm holds the segment part of the pointer
  371.           Offs holds the offset.
  372.  
  373. Corrupts : AX,BX,DI,ES.
  374.  
  375. *)
  376.  
  377. Procedure GetPtrData(pt:pointer; VAR Segm, Offs:word); Assembler;
  378. Asm
  379.    LES DI,PT            { Point ES:DI to where PT is in memory }
  380.    MOV AX,ES            { Set AX to hold segment }
  381.    MOV BX,DI            { BX to hold offset }
  382.  
  383.    LES DI,Segm          { Now write directly to variable Segm }
  384.    MOV [ES:DI],AX
  385.    LES DI,Offs          { And variable Offs }
  386.    MOV [ES:DI],BX
  387. End;
  388.  
  389.  
  390.  
  391.  
  392. {
  393. Switch into VGA256 (320 x 200 x 256 Colour mode).
  394.  
  395. Expects : Nothing
  396.  
  397. Returns : Nothing
  398.  
  399. Affects : It affects the current screen mode (obviously) palette,
  400.           Font (and the weather in eastern Czechoslovakia :-) )
  401.  
  402. Notes  : If all you want to do is clear the screen then use
  403.          Cls or CCls, which does not affect palettes etc.
  404. }
  405.  
  406. Procedure InitVGAMode; Assembler;
  407. asm
  408.    XOR AH,AH
  409.    MOV AL,$13   { Mode 19 is the mode we want ! ;-) }
  410.    INT $10      { VGA 256 Colours here we come }
  411. End;
  412.  
  413.  
  414.  
  415.  
  416.  
  417.  
  418.  
  419. {
  420. ****************************
  421. BITMAP MANIPULATION ROUTINES
  422. ****************************
  423. }
  424.  
  425.  
  426.  
  427. (*
  428. Allocate memory for a virtual screen. (This command
  429. it is ALWAYS 64,000 bytes that are allocated - the same
  430. size as what is used by the VGA bitmap.
  431.  
  432. Expects  : Two empty variables of word size which will be
  433.            used to hold the segment and offset of the virtual
  434.            screen.
  435.  
  436. Returns  : The segment and offset of the memory area.
  437.  
  438. Corrupts : Don't know (and don't care! ).
  439.  
  440. Notes    : Unfortunately Pascal doesnt allow allocation of
  441.            > 64K or incorportate HUGE pointers so therefore
  442.            it was made impossible for me to have a huge bitmap
  443.            that exceeds 64K.
  444.  
  445. *)
  446.  
  447.  
  448. Procedure Bitmap(Var BmapSegment,BmapOffset:word);
  449. Var MemoryAccessVar: pointer;
  450. Begin
  451.      GetMem(MemoryAccessVar,64000);
  452.      GetPtrData(MemoryAccessVar,BmapSegment,BmapOffset);
  453. End;
  454.  
  455.  
  456.  
  457.  
  458.  
  459.  
  460.  
  461.  
  462.  
  463. (*
  464. This routine will free a virtual screen allocated by the
  465. Bitmap routine above.
  466.  
  467. Expects :  The variables passed in as BmapSegment, BmapOffset should hold
  468.            the same contents as what was allocated by Bitmap;
  469.  
  470. Returns :  Your machine may crash if you try and free a Bitmap that has
  471.            not been allocated !
  472.  
  473. Corrupts : Don't know which registers are altered.
  474.  
  475. *)
  476.  
  477.  
  478. Procedure FreeBitmap(BmapSegment,BmapOffset:word);
  479. Var ThePointer: pointer;
  480. Begin
  481.      ThePointer:=Ptr(BmapSegment,BmapOffset);
  482.      FreeMem(ThePointer,64000);
  483. End;
  484.  
  485.  
  486.  
  487.  
  488. {
  489. Procedure used to blit one bitmap to another bitmap. Private
  490. to unit.
  491.  
  492. Expects : DS:SI points to source page
  493.           ES:DI points to destination page
  494.           DX holds data segment address
  495.  
  496. Corrupts : CX,SI,DI.
  497.  
  498. Returns : Nothing
  499.  
  500. }
  501.  
  502.  
  503.  
  504. Procedure FastCopy; Assembler;
  505. Asm
  506.      MOV CX,2000
  507.      CLD
  508.  
  509.      { The reason I have repeated the instructions 8 times is because
  510.      this method is a lot faster than :
  511.  
  512. @Copy:
  513.      DB $F3,$66,$a5
  514.      LOOP @Copy
  515.  
  516.  
  517.      If you are a total speed junkie then why not block copy those
  518.      8 instructions, append them at the bottom, and set CX (Above)
  519.      to 1000. In fact, for total speed freaks why not type 16,000
  520.      of these instructions :-)
  521.  
  522.      Alternatively, buy a Pentium 120. ;-)
  523.  
  524.      (Feb 96 update: No point in me cracking that joke now when
  525.      Melv's got a P133 - how fast technology advances eh?)
  526.      }
  527.  
  528. @Copy:
  529.      DB $66; MOVSW      { MOVSD }
  530.      DB $66; MOVSW
  531.      DB $66; MOVSW
  532.      DB $66; MOVSW
  533.      DB $66; MOVSW
  534.      DB $66; MOVSW
  535.      DB $66; MOVSW
  536.      DB $66; MOVSW      { 32 bytes moved in one loop. Whoa !}
  537.      DEC CX
  538.      JNZ @Copy          { On my 486 this is faster than LOOP }
  539.  
  540.      MOV DS,DX
  541. End;
  542.  
  543.  
  544.  
  545.  
  546.  
  547.  
  548. {
  549. Copy a bitmap in memory to the VGA memory, therefore showing it
  550. on screen.
  551.  
  552. Expects  : BmapSegment, BmapOffset to point to a bitmap in memory.
  553.  
  554. Returns  : Nothing
  555.  
  556.  
  557. Corrupts : AX,CX,DX,SI,DI,ES
  558. }
  559.  
  560.  
  561. Procedure ShowBitmap(BmapSegment,BmapOffset:word); Assembler;
  562. Asm
  563.    MOV DX,DS
  564.    MOV AX,$a000
  565.    MOV ES,AX
  566.    XOR DI,DI
  567.    MOV SI,BmapOffset
  568.    MOV DS,BmapSegment
  569.    CALL FastCopy
  570. End;
  571.  
  572.  
  573.  
  574.  
  575.  
  576.  
  577.  
  578. (*
  579. This copies the Source Bitmap to the Destination Bitmap. Simple as that.
  580. If the Destination Bitmap resides at $a000 : 0 then the VGA screen will
  581. be updated (The main purpose for this routine)
  582.  
  583. Expects : Source Bitmap & Destination Bitmap to point to two legal 64K
  584.           regions of memory (By "legal" I mean you have reserved these
  585.           regions in the program for your own use, or know that they
  586.           are free)
  587.  
  588. Returns : Nothing.
  589.  
  590. Corrupts : CX,DX,DI,ES
  591. *)
  592.  
  593.  
  594. Procedure CopySourceBitmap; Assembler;
  595. Asm
  596.      MOV DX,DS
  597.      MOV ES,DestinationBitmapSegment
  598.      MOV DI,DestinationBitmapOffset
  599.      MOV SI,SourceBitmapOffset
  600.      MOV DS,SourceBitmapSegment
  601.      CALL FastCopy
  602. End;
  603.  
  604.  
  605.  
  606.  
  607.  
  608.  
  609.  
  610. {
  611. Get the segment and offset of the source Bitmap. (Where data
  612. is written to, i.e. Sprites, Lines, etc)
  613.  
  614. Expects : SourceSeg and SourceOfs are two uninitialised word variables
  615.  
  616. Returns : On exit from this routine SourceSeg shall hold the segment and
  617.           SourceOfs shall hold the offset.
  618.  
  619. Corrupts : AX,BX,ES
  620.  
  621. Notes :    The value on unit initialisation is: Segment = $a000
  622.                                                 Offset  = 0.
  623.  
  624. You can change the Source Bitmap address by using SetSourceBitmapAddr.
  625.  
  626. }
  627.  
  628.  
  629. Procedure GetSourceBitmapAddr(VAR SourceSeg,SourceOfs: word); Assembler;
  630. Asm
  631.    MOV AX,SourceBitmapSegment
  632.    MOV BX,SourceBitmapOffset
  633.    LES DI,SourceSeg
  634.    MOV [ES:DI],AX
  635.    LES DI,SourceOfs
  636.    MOV [ES:DI],AX
  637. End;
  638.  
  639.  
  640.  
  641.  
  642.  
  643.  
  644.  
  645.  
  646. {
  647. Set the Source Bitmap address. The source Bitmap is where ALL of the
  648. graphics operations are performed, except for copying.
  649.  
  650.  
  651. Expects : NewSourceSeg = Segment of the new Source Bitmap
  652.           NewSourceOfs = Offset of the new Source Bitmap
  653.  
  654. Returns : Nothing
  655.  
  656. Notes   : The source Bitmap must reside within the first 640K of DOS memory,
  657.           or at segment $a000 (Video Ram).
  658.  
  659.           I am sorry about this limitation but that's MS-DOS for you.
  660.           And before a lot of mail floods in saying "what about using XMS"
  661.           etc. I say, "It's in my new unit, old chap" :-)
  662.  
  663.  
  664. Corrupts : AX
  665. }
  666.  
  667.  
  668. Procedure SetSourceBitmapAddr(NewSourceSeg,NewSourceOfs:word); Assembler;
  669. Asm
  670.      MOV AX,NewSourceSeg
  671.      MOV SourceBitmapSegment,AX
  672.      MOV AX,NewSourceOfs
  673.      MOV SourceBitmapOffset,AX
  674.  
  675. End;
  676.  
  677.  
  678.  
  679.  
  680.  
  681.  
  682. {
  683. Get the address of the Destination Bitmap. (Where data is to be copied
  684. to with CopySourceBitmap).
  685.  
  686. Expects : Two word variables to hold the segment & offset of the
  687.           source Bitmap.
  688.  
  689. Returns : Segment & Offset of the source Bitmap.
  690.  
  691. Corrupts : AX,DI,ES.
  692.  
  693.  
  694. Note : The Destination Bitmap defaults to segment $a000 offset 0.
  695.  
  696.  
  697. }
  698.  
  699. Procedure GetDestinationBitmapAddr(VAR DestinationSeg,DestinationOfs: word); Assembler;
  700. Asm
  701.    MOV AX,DestinationBitmapSegment
  702.    LES DI,DestinationSeg
  703.    MOV [ES:DI],AX
  704.    MOV AX,DestinationBitmapOffset
  705.    LES DI,DestinationOfs
  706.    MOV [ES:DI],AX
  707. End;
  708.  
  709.  
  710.  
  711.  
  712.  
  713.  
  714.  
  715.  
  716.  
  717.  
  718. {
  719. Set the address of the Destination Bitmap.
  720.  
  721.  
  722. Expects :  NewDestinationBitmapSeg is the segment of the New
  723.            Destination Bitmap. (Never! :-) )
  724.            NewDestinationBitmapOfs is the offset.
  725.  
  726. Returns :  Nothing
  727.  
  728. Corrupts : AX
  729.  
  730. }
  731.  
  732. Procedure SetDestinationBitmapAddr(NewDestinationBitmapSeg,NewDestinationBitmapOfs:word); Assembler;
  733. Asm
  734.    MOV AX,NewDestinationBitmapSeg
  735.    MOV DestinationBitmapSegment,AX
  736.    MOV AX,NewDestinationBitmapOfs
  737.    MOV DestinationBitmapOffset,AX
  738. End;
  739.  
  740.  
  741.  
  742.  
  743.  
  744.  
  745. {
  746. By setting the Destination Bitmap to the Source Bitmap, "double buffering"
  747. is effectively turned OFF. This routine is only of use to those who
  748. work with multiple graphics Bitmaps.
  749.  
  750. This will make sure that data is written to the Destination
  751. Bitmap ALWAYS.
  752.  
  753. Expects : Nothing.
  754.  
  755. Returns : DestinationBitmap points to SourceBitmap.
  756.  
  757. Corrupts : AX
  758. }
  759.  
  760.  
  761. Procedure DoubleBufferOff; Assembler;
  762. Asm
  763.    MOV AX,SourceBitmapSegment
  764.    MOV DestinationBitmapSegment,AX
  765.    MOV AX,SourceBitmapOffset
  766.    MOV DestinationBitmapOffset,AX
  767. End;
  768.  
  769.  
  770.  
  771.  
  772.  
  773.  
  774.  
  775.  
  776.  
  777. {
  778. This routine will overlay the SOURCE Bitmap with the DESTINATION
  779. Bitmap (writing the overlaid Bitmap data to the DESTINATION screen)
  780. therefore making it possible to create a parallaxing
  781. effect.
  782.  
  783. Of course, you could simply use it to overlay two PCXs etc. etc.
  784.  
  785.  
  786. Expects : SourceBitmapSegment, SourceBitmapOffset to point to an
  787.           initialised Bitmap. This Bitmap is treated as the
  788.           FOREGROUND. All pixels with colour 0 within the
  789.           bitmap are treated as TRANSPARENT.
  790.  
  791.           The same applies to DestBitmapSegment, DestBitmapOffset.
  792.           The Dest Bitmap is treated as the BACKGROUND.
  793.  
  794. Returns : Nothing
  795.  
  796. Corrupts : AX,CX,DX,SI,DI,ES
  797.  
  798. }
  799.  
  800. Procedure OverlaySourceBitmap; Assembler;
  801. Asm
  802.    MOV DX,DS                    { Save DS - faster than using stack }
  803.  
  804.    MOV DI,DestinationBitmapOffset
  805.    MOV ES,DestinationBitmapSegment
  806.    MOV SI,SourceBitmapOffset
  807.    MOV DS,SourceBitmapSegment
  808.    MOV CX,16000
  809.  
  810. @CheckIfTransparent:
  811.    DB $66                       { 66h indicates 32 bit destination }
  812.    LODSW                        { LODSD -> Read DWORD from source Bitmap
  813.                                 into AX }
  814.    OR AL,AL                     { Check if AL is 0 }
  815.    JZ @ALClear                  { If so, can't overlay it }
  816.    MOV [ES:DI],AL               { Otherwise, write it }
  817.  
  818. @ALClear:
  819.    INC DI
  820.    OR AH,AH                     { Check if AH is 0 }
  821.    JZ @AHClear                  { Shouldn't blit with a 0 byte }
  822.    MOV [ES:DI],AH
  823.  
  824. @AHClear:
  825.    INC DI
  826.    DB $66
  827.    SHR AX,16                    { Move upper word of EAX into
  828.                                   into AH and AL }
  829.    OR AL,AL                     { Check if AL is 0 }
  830.    JZ @EALClear                 { If so, can't overlay it }
  831.    MOV [ES:DI],AL               { Otherwise, write it }
  832.  
  833. @EALClear:
  834.    INC DI
  835.    OR AH,AH                     { Check if AH is 0 }
  836.    JZ @NoBlit                   { Shouldn't blit with a 0 byte }
  837.    MOV [ES:DI],AH
  838.  
  839.  
  840. @NoBlit:
  841.    INC DI                       { Next byte }
  842.    DEC CX                       { Reduce count }
  843.    JNZ @CheckIfTransparent
  844.  
  845.    MOV DS,DX                    { Restore DS }
  846. End;
  847.  
  848.  
  849.  
  850.  
  851.  
  852.  
  853.  
  854. {
  855. ***********************
  856. PRIMITIVE DRAWING TOOLS
  857. ***********************
  858. }
  859.  
  860.  
  861. {
  862. Calculate the offset of a pixel on the SOURCE Bitmap.
  863.  
  864. Registers expected on entry:
  865. AX = the horizontal coordinate (0 to GetMaxX) and ..
  866. BX = the vertical coordinate (0 to GetMaxY)
  867.  
  868.  
  869. Returns  : BX = -1 if X or Y were out of bounds.
  870.            Otherwise, BX is an offset, which, combined with
  871.            the contents of SourceBitmapSegment point to an address
  872.            in RAM where the pixel can be plotted/read from.
  873.  
  874. Notes    : This routine is private to the unit. To maintain
  875.            compatibility with further revisions (which I churn out
  876.            with frightening regularity ;-) ) I recommend all extra
  877.            unit routines that require a pixel address calc'ed call
  878.            this proc.
  879.  
  880. Corrupts : AX, BX, CX are corrupted.
  881.  
  882. }
  883.  
  884.  
  885. Procedure CalculateOffset; Near; Assembler;
  886. Asm
  887.      CMP AX,319         { Is X> 319 ? }
  888.      JA @OutOfBounds    { Yes }
  889.      CMP BX,199         { Is Y> 199 ?. Do not use BL instead as this is
  890.                           when problems will occur.}
  891.      JA @OutOfBounds    { Yes }
  892.  
  893.      XOR CH,CH                  { CX = Y }
  894.      MOV CL,BL
  895.      SHL CX,6                   { Y * 64 }
  896.      MOV BH,BL                  { BX = Y * 256 }
  897.      XOR BL,BL
  898.      ADD BX,CX                  { BX = BX + CX, which gives Y * 320 }
  899.      ADD BX,AX                  { Add the X position to offset in BX }
  900.      ADD BX,SourceBitmapOffset    { Take into account the offset in memory
  901.                                   of the source Bitmap }
  902.  
  903.      JMP @Finito                { And exit. }
  904.  
  905. @OutOfBounds:
  906.      MOV BX,-1                  { Signal that coordinates were not within
  907.                                   the screen limits }
  908.  
  909. @Finito:
  910. End;
  911.  
  912.  
  913.  
  914.  
  915.  
  916.  
  917. {
  918. This GetPixel routine differs from the Turbo equivalent as the
  919. return type is integer, not word. A small point, but still
  920. (UN)worth mentioning. <grin>
  921.  
  922. Expects  : X and Y specify the horizontal and vertical coordinates of
  923.            a pixel. X may be 0..GetMaxX, Y may be 0..GetMaxY.
  924.  
  925. Returns  : If the coordinates are within screen bounds, then GetPixel =
  926.            Colour at X,Y. If not, then GetPixel = -1.
  927.  
  928. Corrupts : AX/BX/CX/DX/FS.
  929. }
  930.  
  931. Function GetPixel(X,Y: integer): integer; Assembler;
  932. Asm
  933.    MOV AX,X
  934.    MOV BX,Y
  935.  
  936.    CALL CalculateOffset         { Now get offset in BX }
  937.    CMP BX,-1                    { Is coordinate off screen ? }
  938.    JZ @NoGet                    { Yes, so return value of -1 }
  939.    DB $8E, $26
  940.    DW OFFSET SourceBitmapSegment
  941.  
  942.    XOR AH,AH
  943.    DB $64
  944.    MOV AL,[BX]
  945.  
  946.    JMP @Finished                { Can't put a RET here - maybe this
  947.                                   unit was compiled in FAR mode, and
  948.                                   a crash would occur! }
  949.  
  950. @NoGet:
  951.    MOV AX,BX                    { AX = -1, meaning no pixel could be
  952.                                   read }
  953.  
  954. @Finished:
  955. End;
  956.  
  957.  
  958.  
  959.  
  960.  
  961.  
  962. {
  963. Write a pixel to the screen.
  964.  
  965. Expects :  AX to be the X coord for a pixel (0 to GetMaxX),
  966.            BX for the Y coord (0 to GetMaxY) - Don't be tempted
  967.            to optimize the code by using BL, as this causes
  968.            problems when using negative Y coordinates. (As some
  969.            programs will)
  970.            DL is the colour (0 to 255) to plot.
  971.  
  972. Returns :  Nothing
  973.  
  974. Notes   :  This putpixel is private to the unit and should be
  975.            used when plotting pixels that MAY be off screen
  976.            to keep in step with the rest of the unit.
  977.  
  978. On exit AX,BX,CX,DX,FS are corrupt.
  979. }
  980.  
  981.  
  982. Procedure FPutPixel; Near; Assembler;
  983. Asm
  984.    CALL CalculateOffset                 { AX/ BX already set up }
  985.    CMP BX,-1                            { Coordinates off screen ? }
  986.    JA @NoPlot                           { Yeah, so don't put pixel }
  987.    DB $8E,$26                           { MOV FS, [SourceBitmapSegment] }
  988.    DW OFFSET SourceBitmapSegment
  989.    DB $64                               { MOV [FS:BX],DL }
  990.    MOV [BX],DL
  991.  
  992. @NoPlot:
  993. End;
  994.  
  995.  
  996.  
  997.  
  998.  
  999.  
  1000.  
  1001. {
  1002. This is the Pascal interface for the Fputpixel routine, it's
  1003. really quite sad how Pascal uses the stack so much, when you see
  1004. the likes of Turbo C & it's (amazingly interesting) register
  1005. usage which is quite fast. :(
  1006.  
  1007. But not as fast as me when I'm going to the pub. :-)
  1008.  
  1009. Expects : X = Horizontal coordinate of a pixel (0-GetMaxX)
  1010.           Y = Vertical coordinate of a pixel (0-GetMaxY)
  1011.           ColourValue = Colour to plot , 0 - 255.
  1012.  
  1013. Returns : Nothing
  1014.  
  1015. Corrupts : See FPutPixel.
  1016. }
  1017.  
  1018. Procedure PutPixel(x, y : integer; ColourValue : Byte); Assembler;
  1019. Asm
  1020.    MOV AX,x               { I wish TP had the capacity to load these
  1021.                             automatically for you, instead of creating
  1022.                             a crappy stack frame and pushing X, Y. }
  1023.    MOV BX,y               { Is it any wonder I love C++ more ? }
  1024.    MOV DL,ColourValue
  1025.    CALL FPutPixel         { Don't use a JMP, your program will crash }
  1026. End;
  1027.  
  1028.  
  1029.  
  1030.  
  1031.  
  1032.  
  1033.  
  1034. {
  1035. This line routine was converted to assembler (by ME!!) from the
  1036. SWAG team's line draw routine (in Pascal) which was very fast.
  1037. So this means this'll be ULTRA FAST (hopefully ;-) ).
  1038.  
  1039. Bresenham who ? :-)  Diamond Geezer.
  1040.  
  1041. I wonder if this is faster than Sean Palmer's line draw in ASM ?
  1042. (Check the SWAG for that program - it's smart)
  1043.  
  1044. Expects : X1,Y1 defines the horizontal, vertical start of the line
  1045.           X2,Y2 defines the horizontal, vertical end of the line.
  1046.           Coordinates may be negative or exceed screen bounds.
  1047.  
  1048.           Line will be drawn in CurrentColour.
  1049.  
  1050. Returns : Nothing
  1051.  
  1052. Corrupts: AX,BX,CX,DX,SI,DI,ES,FS.
  1053.  
  1054. }
  1055.  
  1056.  
  1057. Procedure Line(X1, Y1, X2, Y2: Integer); Assembler;
  1058. Var
  1059.   LgDelta,
  1060.   ShDelta,
  1061.   LgStep,
  1062.   ShStep,
  1063.   Cycle : word;
  1064.  
  1065. Asm
  1066.   MOV BX,X2             { LgDelta = X2 - X1 }
  1067.   MOV SI,X1
  1068.   SUB BX,SI
  1069.   MOV LgDelta,BX
  1070.  
  1071.   MOV CX,Y2             { ShDelta = Y2 - Y1 }
  1072.   MOV DI,Y1
  1073.   SUB CX,DI
  1074.   MOV ShDelta,CX
  1075.  
  1076.   TEST BH,$80           { If bit 7 not set .. }
  1077.   JZ @LgDeltaPos        { Goto LgDeltaPos }
  1078.  
  1079.   NEG BX
  1080.   MOV LgDelta,BX
  1081.   MOV LgStep,$FFFF
  1082.   JMP @Cont1
  1083.  
  1084. @LgDeltaPos:
  1085.   MOV LgStep,1
  1086.  
  1087. @Cont1:
  1088.   CMP CH,$80           { If ShDelta < 0 Then.. }
  1089.   JB @ShDeltaPos
  1090.   NEG CX
  1091.   MOV ShDelta,CX
  1092.   MOV ShStep,$FFFF
  1093.   JMP @Cont2
  1094.  
  1095. @ShDeltaPos:
  1096.   MOV ShStep,1
  1097.  
  1098. @Cont2:
  1099.   CMP BX,CX                   { BX = LgDelta, CX = ShDelta }
  1100.   JB @OtherWay
  1101.  
  1102.   SHR BX,1                    { Cycle:= LgDelta SHR 1 }
  1103.   MOV Cycle,BX
  1104.  
  1105.   {
  1106.   O.K. I'm going to use :
  1107.   SI as X1, DI as Y1, CX as X2, DX as Y2.
  1108.   }
  1109.  
  1110.   MOV CX,X2
  1111.  
  1112. @FirstLoop:
  1113.   CMP SI,CX             { While X1 <> X2 }
  1114.   JZ @GetTheShitOut     { Why not have an expletive as a label ? }
  1115.  
  1116.   MOV AX,SI              { Set AX and BX to X1,Y1 ready for call }
  1117.   MOV BX,DI              { BX = Y1 }
  1118.  
  1119.   MOV ES,CX              { The only free register ! }
  1120.   MOV DL,CurrentColour
  1121.   CALL FPutPixel
  1122.   MOV CX,ES
  1123.  
  1124.   ADD SI, LgStep         { X1 = X1 + LgStep }
  1125.   MOV AX,Cycle
  1126.   ADD AX,ShDelta         { Inc(Cycle,ShDelta) }
  1127.   MOV Cycle,AX           { Yes I did check the code and this is fastest }
  1128.  
  1129.   MOV BX,LgDelta
  1130.   CMP AX,BX              { If Cycle > LgDelta }
  1131.   JB @FirstLoop
  1132.  
  1133.   ADD DI,ShStep          { Y1 = Y1 + ShStep }
  1134.   SUB AX,LgDelta         { Dec(Cycle,LgDelta) }
  1135.   MOV Cycle,AX
  1136.   JMP @FirstLoop
  1137.  
  1138.   {
  1139.   O.K. If we go in a different direction..
  1140.  
  1141.   On entry, BX = LgDelta, CX = ShDelta
  1142.  
  1143.   }
  1144.  
  1145. @OtherWay:
  1146.   MOV AX,CX
  1147.   SHR AX,1              { ShDelta SHR 1 }
  1148.   MOV Cycle,AX
  1149.   XCHG BX,CX            { BX = ShDelta, CX = LgDelta }
  1150.   MOV LgDelta, BX
  1151.   MOV ShDelta, CX
  1152.  
  1153.   MOV BX,LgStep         { Swap LgStep and ShStep round }
  1154.   MOV CX,ShStep
  1155.   MOV ShStep,BX
  1156.   MOV LgStep,CX
  1157.  
  1158.   {MOV CX,X2}             { CX = X2, DX = Y2 }
  1159.   MOV DX,Y2
  1160.  
  1161. @SecondLoop:
  1162.   CMP DI,DX             { While Y1 <> Y2 do }
  1163.   JZ @GetTheShitOut
  1164.  
  1165.  
  1166. {
  1167. If it can, then it's time for action!
  1168. }
  1169.  
  1170.   MOV AX,SI             { Set AX and BX to X1,Y1 }
  1171.   MOV BX,DI             { BX = Y1 }
  1172.  
  1173.   MOV ES,DX             { Sorry, but this was the only free register ! }
  1174.   MOV DL,CurrentColour
  1175.   CALL FPutPixel
  1176.   MOV DX,ES             { .. Please don't think I am sloppy ! }
  1177.  
  1178.   ADD DI,LgStep         { Inc(Y1,LgStep) }
  1179.   MOV AX,Cycle          { Inc(Cycle,ShDelta) }
  1180.   ADD AX,ShDelta
  1181.   MOV Cycle,AX
  1182.  
  1183.   MOV BX,LgDelta
  1184.  
  1185.   CMP AX,BX             { If Cycle > LgDelta Then.. }
  1186.   JB @SecondLoop
  1187.  
  1188.   ADD SI,ShStep         { Inc(X1,ShStep) }
  1189.   SUB Cycle,BX          { Dec(Cycle,LgDelta) }
  1190.   JMP @SecondLoop
  1191.  
  1192. @GetTheShitOut:
  1193.   MOV AX,X2             { Write last pixel. This was an absolute }
  1194.   MOV BX,Y2             { b****** to debug :-) }
  1195.   MOV DL,CurrentColour
  1196.   CALL FPutPixel        { Just a wee bit of Scottish humour there }
  1197.  
  1198. End;
  1199.  
  1200.  
  1201.  
  1202.  
  1203.  
  1204.  
  1205.  
  1206.  
  1207.  
  1208. {
  1209. Draw a line relative from the current cursor position.
  1210. Relative means that the DiffX and DiffY values are added to the
  1211. current cursor coordinates to give the resulting horizontal and vertical
  1212. end points of the line.
  1213.  
  1214. For example, if CursorX and CursorY were 10,10 and DiffX and DiffY
  1215. were -10,-10 then the line would be drawn to position 0,0. Conversely,
  1216. if DiffX was 10 and DiffY was 20 then the cursor would be drawn to
  1217. X 20, Y 30.
  1218.  
  1219.  
  1220. Expects : DiffX is a non zero value that may be negative, which
  1221.           specifies the relative distance from the current horizontal
  1222.           cursor position.
  1223.  
  1224.           DiffY specifies the relative distance from the current
  1225.           vertical position.
  1226.  
  1227. Returns : Nothing
  1228.  
  1229. Corrupts : Probably the same as the Line routine.
  1230. }
  1231.  
  1232. Procedure LineRel(DiffX,DiffY: integer); Assembler;
  1233. Asm
  1234.      MOV AX,CursorX
  1235.      MOV BX,AX
  1236.      ADD BX,DiffX
  1237.      MOV CX,CursorY
  1238.      MOV DX,CX
  1239.      ADD DX,DiffY
  1240.  
  1241.      {
  1242.      Strange method of reading the stack, Borland. :-(
  1243.      }
  1244.  
  1245.      PUSH BX            { X + DiffX }
  1246.      PUSH DX            { Y + DiffY }
  1247.      PUSH AX            { X }
  1248.      PUSH CX            { Y }
  1249.      CALL Line          { Must return so dynamic vars can be moved.
  1250.                           Wish I could get rid of them quicker. }
  1251. End;
  1252.  
  1253.  
  1254.  
  1255.  
  1256.  
  1257.  
  1258.  
  1259.  
  1260. {
  1261. Draw from the current cursor position to the horizontal and vertical
  1262. positions specified by EndX and EndY. The Graphics Cursor will be
  1263. moved to EndX, EndY.
  1264.  
  1265. Expects : EndX to be the horizontal position of the line end. (0 to GetMaxX)
  1266.           EndY to be the vertical position of the line end. (0 to GetMaxY)
  1267.  
  1268. Returns : Nothing, but you should be aware that the graphics cursor
  1269.           position is now at EndX, EndY.
  1270.  
  1271. Corrupts : AX,BX,CX,DX,SI,DI,ES,FS
  1272. }
  1273.  
  1274. Procedure LineTo(EndX,EndY:integer); Assembler;
  1275. Asm
  1276.    PUSH EndX
  1277.    PUSH EndY
  1278.    PUSH CursorX
  1279.    PUSH CursorY
  1280.    CALL Line
  1281.    MOV AX,EndX
  1282.    MOV CursorX,AX
  1283.    MOV AX,EndY
  1284.    MOV CursorY,AX
  1285. End;
  1286.  
  1287.  
  1288.  
  1289.  
  1290.  
  1291.  
  1292.  
  1293. {
  1294. Probably not the fastest rectangle draw you'll see.
  1295. But it is economical with memory, and it works !
  1296.  
  1297. Expects  : X1,Y1,X2,Y2 define a rectangular window.
  1298.  
  1299. Returns  : Nothing
  1300.  
  1301. Corrupts : Not a clue.
  1302.  
  1303. Notes    : This routine does not move the graphics cursor.
  1304. }
  1305.  
  1306.  
  1307. Procedure Rectangle(x1,y1,x2,y2:integer);
  1308. Begin
  1309.      Line(x1,y1,x2,y1);         { Top Line    }
  1310.      Line(x1,y2,x2,y2);         { Bottom Line }
  1311.      Line(x1,y1+1,x1,y2-1);     { Left edge   }
  1312.      Line(x2,y1+1,x2,y2-1);     { Right edge  }
  1313. End;
  1314.  
  1315.  
  1316.  
  1317.  
  1318.  
  1319.  
  1320.  
  1321.  
  1322.  
  1323. {
  1324. Change position of graphics cursor.
  1325.  
  1326. Expects : NewCursX and NewCursY are the horizontal and vertical
  1327.           coordinates that you wish to move the cursor to.
  1328.           NewCursX may be negative or more than GetMaxX.
  1329.           NewCursY may be negative or more than GetMaxY.
  1330.  
  1331. Returns : Nothing
  1332.  
  1333. Corrupts : AX.
  1334. }
  1335.  
  1336. Procedure MoveTo(NewCursX,NewCursY:integer); Assembler;
  1337. Asm
  1338.    MOV AX,NewCursX
  1339.    MOV CursorX,AX
  1340.    MOV AX,NewCursY
  1341.    MOV CursorY,AX
  1342. End;
  1343.  
  1344.  
  1345.  
  1346.  
  1347.  
  1348.  
  1349.  
  1350.  
  1351.  
  1352.  
  1353. {
  1354. Returns horizontal position of graphics cursor.
  1355. GetX May be negative.
  1356.  
  1357. Expects : Nothing
  1358.  
  1359. Returns : GetX = Current graphics cursor horizontal position, which
  1360.           may be negative or even exceed GetMaxX.
  1361. }
  1362.  
  1363. Function GetX: integer; Assembler;
  1364. Asm
  1365.    MOV AX,CursorX
  1366. End;
  1367.  
  1368.  
  1369.  
  1370.  
  1371.  
  1372.  
  1373.  
  1374.  
  1375. {
  1376. Returns vertical position of graphics cursor.
  1377. GetY may be negative.
  1378.  
  1379. Expects : Nothing
  1380.  
  1381. Returns : GetY = Current graphics cursor vertical position, which
  1382.           may be negative or even exceed GetMaxY.
  1383.  
  1384.  
  1385. }
  1386.  
  1387. Function GetY: integer; Assembler;
  1388. Asm
  1389.      MOV AX, CursorY
  1390. End;
  1391.  
  1392.  
  1393.  
  1394.  
  1395.  
  1396.  
  1397.  
  1398.  
  1399.  
  1400.  
  1401.  
  1402. {
  1403. *************
  1404. FONT ROUTINES
  1405. *************
  1406.  
  1407. }
  1408.  
  1409.  
  1410. {
  1411. Select which of the Fonts in ROM you use to write text to the
  1412. screen.
  1413.  
  1414. Expects : FontNumber can be:
  1415.  
  1416.           0: For CGA Font (Dunno what size it is tho')
  1417.           1: For 8 x 8 Font
  1418.           2: For 8 x 14 Font
  1419.           3: For 8 x 8 Font
  1420.           4: For 8 x 8 Font high 128 characters
  1421.           5: For Rom Alpha Alternate Font
  1422.           6: For 8 x 16 Font
  1423.           7: For Rom Alternate 9 x 16 Font
  1424.  
  1425.  
  1426. Returns : Nothing
  1427.  
  1428. Corrupts : AX,BX,ES
  1429.  
  1430. }
  1431.  
  1432. Procedure UseFont(FontNumber:byte); Assembler;
  1433. Asm
  1434.      MOV AX,$1130                      { Get Font address }
  1435.      MOV BH,FontNumber
  1436.      CMP BH,7                          { Font number > 7 ? }
  1437.      JA @NoWriteSize                   { Yes, so it's invalid }
  1438.  
  1439.      PUSH BP                           { Mustn't corrupt BP, as Turbo
  1440.                                          needs it preserved for local
  1441.                                          variable access }
  1442.      PUSH BX                           { Nor BH as it's to be used later }
  1443.      INT $10                           { Now get Font address }
  1444.      MOV CurrentFontSegMent,ES         { ES:BP points to where Font is }
  1445.      MOV CurrentFontOffset,BP          { located in ROM }
  1446.      POP BX                            { Restore Font number }
  1447.      POP BP                            { Restore BP }
  1448.  
  1449.      CMP BH,Int1fFont                  { User Font in memory ? }
  1450.      JZ @NoWriteSize                   { Don't set size, could be more than
  1451.                                          8 x 8. User will have to set himself.
  1452.                                          Please correct me if I am wrong }
  1453.      CMP BH,Font8x8                    { User want any of the 8 x 8 Fonts ? }
  1454.      JZ @Set8x8
  1455.      CMP BH,Font8x8dd
  1456.      JZ @Set8x8
  1457.      CMP BH,Font8x8ddHigh
  1458.      JZ @Set8x8
  1459.      CMP BH,AlphaAlternateFont
  1460.      JNZ @Check8x14Font
  1461.  
  1462. @Set8x8:
  1463.      MOV AL,8                          { Width of 8 }
  1464.      MOV AH,8                          { Height of 8 }
  1465.      MOV BL,1                          { 1 byte's width }
  1466.      JMP @DoWrite
  1467.  
  1468.  
  1469.  
  1470. @Check8x14Font:
  1471.      CMP BH,Font8x14
  1472.      JNZ @Check8x16Font
  1473.      MOV AL,8                          { Width 8, Height 14, ByteWidth 1 }
  1474.      MOV AH,14
  1475.      MOV BL,1
  1476.      JMP @DoWrite
  1477.  
  1478. @Check8x16Font:
  1479.      CMP BH,Font8x16
  1480.      JNZ @UseRomAlternateFont
  1481.      MOV AL,8                          { Oh C'mon do I have to document }
  1482.      MOV AH,16                         { this ? }
  1483.      MOV BL,1
  1484.      JMP @DoWrite
  1485.  
  1486. @UseRomAlternateFont:
  1487.      MOV AL,9
  1488.      MOV AH,16
  1489.      MOV BL,2
  1490.  
  1491.  
  1492. @DoWrite:
  1493.      MOV CurrentFontWidth,AL           { Write Font details so that }
  1494.      MOV CurrentFontByteWidth,BL       { outtextXY etc. can work with }
  1495.      MOV CurrentFontHeight,AH          { this Font }
  1496.  
  1497. @NoWriteSize:
  1498. End;
  1499.  
  1500.  
  1501.  
  1502.  
  1503.  
  1504.  
  1505. {
  1506. If you wish to do your own text routines, then this returns the
  1507. address of the current Font in FontSeg and FontOfs which specify the
  1508. segment and offset address of the character set.
  1509.  
  1510. Expects  : Two uninitialised word variables
  1511.  
  1512. Returns  : FontSeg = Segment where Font is located
  1513.            FontOfs = Offset of Font
  1514.  
  1515. Corrupts : AX,DI,ES.
  1516.  
  1517. }
  1518.  
  1519. Procedure GetCurrentFontAddr(VAR FontSeg, FontOfs:word); Assembler;
  1520. Asm
  1521.    MOV AX,CurrentFontSegment
  1522.    LES DI,FontSeg
  1523.    MOV [ES:DI],AX
  1524.    MOV AX,CurrentFontOffset
  1525.    LES DI,FontOfs
  1526.    MOV [ES:DI],AX
  1527. End;
  1528.  
  1529.  
  1530.  
  1531.  
  1532.  
  1533.  
  1534. {
  1535. If you want to use a Font loaded in from disk use SetFontAddr to
  1536. specify where the new Font resides in memory.
  1537.  
  1538. Expects : NewFontSeg and NewFontOfs are the segment and offset of the
  1539.           address.
  1540.  
  1541. Returns : Nothing
  1542.  
  1543. Corrupts : AX
  1544. }
  1545.  
  1546. Procedure SetCurrentFontAddr(NewFontSeg,NewFontOfs:word); Assembler;
  1547. Asm
  1548.    MOV AX,NewFontSeg
  1549.    MOV CurrentFontSegment,AX
  1550.    MOV AX,NewFontOfs
  1551.    MOV CurrentFontOffset,AX
  1552. End;
  1553.  
  1554.  
  1555.  
  1556.  
  1557.  
  1558.  
  1559.  
  1560. {
  1561. Find out what width and height the current Font is.
  1562.  
  1563. Expects: CurrFontWidth and CurrFontHeight are two uninitialised
  1564.          variables.
  1565.  
  1566. Returns: CurrFontWidth and CurrFontHeight on exit hold the width
  1567.          and height of the current Font. (Bet you never guessed that, huh)
  1568.  
  1569. Corrupts : AX,DI,ES
  1570. }
  1571.  
  1572.  
  1573. Procedure GetCurrentFontSize(Var CurrFontWidth, CurrFontHeight:byte); Assembler;
  1574. Asm
  1575.    MOV AL,CurrentFontWidth
  1576.    MOV AH,CurrentFontHeight
  1577.  
  1578.    LES DI,CurrFontWidth         { ES: DI points to variable now }
  1579.    MOV [ES:DI],AL
  1580.    LES DI,CurrFontHeight
  1581.    MOV [ES:DI],AH
  1582. End;
  1583.  
  1584.  
  1585.  
  1586.  
  1587.  
  1588.  
  1589.  
  1590. {
  1591. Specify width and height of a user created Font.
  1592.  
  1593. Expects  : NewFontWidth must be above 7,
  1594.            NewFontHeight can be any non-zero number.
  1595.  
  1596. Returns  : Nothing
  1597.  
  1598. Corrupts : AX
  1599.  
  1600. }
  1601.  
  1602. Procedure SetCurrentFontSize(NewFontWidth, NewFontHeight:byte); Assembler;
  1603. Asm
  1604.      MOV AL,NewFontWidth
  1605.      MOV AH,NewFontHeight
  1606.  
  1607.      CMP AL,8                   { Width >= 8 ? }
  1608.      JB @IllegalSize
  1609.      OR AH,AH                   { Is Height 0 ? }
  1610.      JZ @IllegalSize
  1611.  
  1612.      MOV CurrentFontWidth,AL
  1613.      MOV CurrentFontHeight,AH
  1614.      SHR AL,3                   { Calculate byte width of characters
  1615.                                   i.e. divide width in pixels by 8 }
  1616.      MOV CurrentFontByteWidth,AL
  1617.  
  1618. @IllegalSize:
  1619.  
  1620. End;
  1621.  
  1622.  
  1623.  
  1624.  
  1625.  
  1626.  
  1627.  
  1628. {
  1629. For those of you who want to do your own text routines, this
  1630. Procedure may lighten your workload a bit.
  1631.  
  1632. Expects : Characternumber to be (obviously) the number of the
  1633.           character.
  1634.  
  1635. Returns : This Function returns the offset address of character.
  1636.  
  1637. Corrupts : AX,BX,DX
  1638. }
  1639.  
  1640. Function GetROMCharOffset(CharNum:byte): word; assembler;
  1641. Asm
  1642.    MOV AL,CharNum                  { Get number of character into AL }
  1643.    MOV BH,CurrentFontByteWidth
  1644.    MOV BL,CurrentFontHeight
  1645.    MUL BL                          { Multiply character num by FontHeight }
  1646.    MOV BL,BH
  1647.    XOR BH,BH
  1648.    MUL BX                          { And FontWidth }
  1649.    ADD AX,CurrentFontOffset        { Now add in the font offset }
  1650. End;
  1651.  
  1652.  
  1653.  
  1654.  
  1655.  
  1656.  
  1657.  
  1658. (*
  1659. This routine lets you load bitmapped Font files (created by this
  1660. unit) from disk. Currently I am examining the file format of
  1661. Compugraphic Fonts and basically I understand absolutely sod all
  1662. of it.. send me some code for reading them please !!
  1663.  
  1664.  
  1665. FontType = record
  1666.    FontSeg    : Word;           { Where Font is located; when loaded }
  1667.    FontOfs    : Word;           { in these are set by system }
  1668.    FontWidth  : Byte;           { Width (In Pixels) }
  1669.    FontByteWidth : Byte;
  1670.    FontHeight : Byte;           { Height (In Pixels) }
  1671.    FontChars  : Byte;           { Number of characters in Font }
  1672. End;
  1673.  
  1674.  
  1675. *)
  1676.  
  1677.  
  1678. Procedure LoadFont(FontFileName:String; Var FontRec: FontType);
  1679. Var FontFile : File;
  1680.     BytesToReserve : word;
  1681.     FontPtr : Pointer;
  1682.  
  1683. Begin
  1684.      Assign(FontFile,FontFileName);
  1685.      Reset(FontFile,1);
  1686.      BlockRead(FontFile,FontRec,SizeOf(FontRec));
  1687.      With FontRec Do
  1688.           Begin
  1689.           BytesToReserve:=FontChars * (FontByteWidth * FontHeight);
  1690.           GetMem(FontPtr,BytesToReserve);
  1691.           GetPtrData(FontPtr,FontSeg,FontOfs);
  1692.           BlockRead(FontFile,Mem[FontSeg:FontOfs],BytesToReserve);
  1693.      End;
  1694.      Close(FontFile);
  1695. End;
  1696.  
  1697.  
  1698.  
  1699.  
  1700.  
  1701.  
  1702.  
  1703. {
  1704. This routine will save a portion (or all) of the current Font to disk.
  1705.  
  1706. Expects : FontFileName to be an MS-DOS filename to hold the char data.
  1707.           FirstChar to be the number of the first character to save
  1708.           (0-255);
  1709.           NumChars to be the number of characters to save (You may
  1710.           only want to save part of a Font).
  1711.  
  1712. Returns  : Nothing
  1713.  
  1714. Corrupts : Don't know.
  1715. }
  1716.  
  1717.  
  1718. Procedure SaveFont(FontFileName:String; FirstChar, Numchars:byte);
  1719. Var TempFontRec     : FontType;
  1720.     FontFile        : File;
  1721.     BytesPerChar    : word;
  1722.     FirstCharOffset : word;
  1723.  
  1724. Begin
  1725.      With TempFontRec do
  1726.           Begin
  1727.           FontSeg:=0;               { 0 Meaning uninitialised }
  1728.           FontOfs:=0;
  1729.           FontByteWidth:=CurrentFontByteWidth;
  1730.           FontWidth:=CurrentFontWidth;
  1731.           FontHeight:=CurrentFontHeight;
  1732.           FontChars:=NumChars;
  1733.      End;
  1734.  
  1735.      Assign(FontFile,FontFileName);
  1736.      Rewrite(FontFile,1);
  1737.      BlockWrite(FontFile,TempFontRec,SizeOf(TempFontRec));
  1738.  
  1739.      BytesPerChar:=CurrentFontByteWidth * CurrentFontHeight;
  1740.      FirstCharOffset:=CurrentFontOffset+(FirstChar * BytesPerChar);
  1741.  
  1742.      BlockWrite(FontFile, Mem[CurrentFontSegment:FirstCharOffset],
  1743.      NumChars * BytesPerChar);
  1744.  
  1745.      Close(FontFile);
  1746.  
  1747.  
  1748. End;
  1749.  
  1750.  
  1751.  
  1752.  
  1753.  
  1754.  
  1755. {
  1756. Use a Font loaded in from disk. Yes, I know there are many Font load
  1757. routines in the SWAG and most (if not ALL) use interrupt 10h to do
  1758. the business. But my routine doesn't because quite frankly using the
  1759. BIOS is slow, cack, and is far too limiting.
  1760.  
  1761. This routine allows characters of ANY size.
  1762.  
  1763. Expects : Variable FontRec to have been initialised (usually by LoadFont).
  1764.           You could initialise FontRec yourself if you liked and
  1765.           that would be faster than using SetFontAddr, SetFontSize etc.
  1766.  
  1767. Returns : Nothing
  1768.  
  1769. Corrupts : Don't know. That's the thing about Pascal!
  1770. }
  1771.  
  1772.  
  1773. Procedure UseLoadedFont(FontRec : FontType);
  1774. Begin
  1775.      With FontRec Do
  1776.           Begin
  1777.           CurrentFontSegment:=FontSeg;
  1778.           CurrentFontOffset:=FontOfs;
  1779.           SetCurrentFontSize(FontWidth,FontHeight);
  1780.      End;
  1781. End;
  1782.  
  1783.  
  1784.  
  1785.  
  1786.  
  1787.  
  1788.  
  1789.  
  1790. {
  1791. Display text at a position on screen. (May be off screen)
  1792.  
  1793. Expects : X,Y specify the top left of where the text is to be
  1794.           printed.
  1795.           txt is the actual text to be printed.
  1796.  
  1797. Returns : Graphics cursor position is changed. (In normal Turbo
  1798.           it is not, but what the hell)
  1799.  
  1800. Corrupts : AX,BX,CX,DX,SI,DI,ES,FS,GS.
  1801.  
  1802. }
  1803.  
  1804.  
  1805. Procedure OutTextXY(x,y:integer; txt:string); Assembler;
  1806. Asm
  1807.          MOV AX,X
  1808.          MOV CursorX,AX
  1809.          MOV AX,Y
  1810.          MOV CursorY,AX
  1811.  
  1812.          XOR BH,BH                    { Get Font height into BX }
  1813.          MOV BL,CurrentFontHeight
  1814.          NEG BX                       { Make BX negative number }
  1815.  
  1816.          CMP AX,BX                    { Check if text would not be
  1817.                                         seen at top edge of screen
  1818.                                         (i.e. If -FontHeight >
  1819.                                         CursorY) }
  1820.          JL @NoWrite                  { Yes, so don't write text }
  1821.  
  1822.          CMP AX,199                   { Check if off bottom of screen }
  1823.          JG @NoWrite                  { Yes, so don't write text }
  1824.  
  1825.          PUSH BP
  1826.          LES DI,TXT                   { Yes, I know LGS DI exists but
  1827.                                         it's a lot of hassle to find
  1828.                                         out it's opcodes !}
  1829.          MOV AX,ES
  1830.          DB $8E,$E8                   { MOV GS, AX }
  1831.  
  1832.          DB $65                       { GS : }
  1833.          MOV CL,[DI]                  { MOV CL, [GS:DI]
  1834.                                         CL = Length of string }
  1835.  
  1836. @ReadChar:
  1837.  
  1838.          INC DI                      { Prepare to read char }
  1839.          PUSH DI                     { And offset of char }
  1840.          PUSH CX
  1841.  
  1842.          DB $65                      { GS : }
  1843.          MOV AL,[DI]                 { AL = Character }
  1844.          XOR AH,AH
  1845.  
  1846.  
  1847.  
  1848.          PUSH AX
  1849.  
  1850.          MOV AL,CurrentFontByteWidth   { Now compute Fontbytewidth
  1851.                                          * Fontheight }
  1852.          MOV BL,CurrentFontHeight
  1853.  
  1854.          MUL BL                        { Fontbytewidth * FontHeight }
  1855.          MOV DI,AX                     { DI = Result }
  1856.  
  1857.          POP AX                        { Restore character number }
  1858.          MUL DI                        { AX = Char * (FontByteWidth *
  1859.                                          FontHite) }
  1860.  
  1861.          ADD AX,CurrentFontOffset
  1862.          MOV DI,AX                     { Now DI is correctly placed }
  1863.  
  1864.  
  1865.          {
  1866.          Now blit the data to the screen
  1867.          Come on Bas, write something faster for this purpose..
  1868.          Bet you can't !
  1869.          }
  1870.  
  1871.          MOV ES,CurrentFontSegment
  1872.  
  1873.          MOV AX,CursorX              { Update graphic coordinates }
  1874.          MOV BX,CursorY
  1875.  
  1876.          MOV CH,CurrentFontHeight
  1877.  
  1878. @ScanLineLoop:
  1879.          PUSH CX                     { Save Vert Count on stack }
  1880.          MOV CH,CurrentFontByteWidth
  1881.  
  1882. @OuterLoop:
  1883.  
  1884.          MOV CL,[ES:DI]        { Read byte from charmap }
  1885.          OR CL,CL              { test if it's 0 }
  1886.          JZ @RestoreByteOffset { If so, no point in wasting CPU time }
  1887.  
  1888.          {
  1889.          Otherwise..
  1890.          }
  1891.  
  1892.          MOV BP, AX            { Save X - Coord }
  1893.          MOV DH,8              { 8 bits make a character's byte }
  1894.          MOV DL,CurrentColour   { FPutPixel needs this }
  1895.  
  1896.  
  1897. @PlotLoop:
  1898.          TEST CL,$80           { Bit 7 set ? }
  1899.          JZ @NoPlot            { No, so don't plot a pixel }
  1900.  
  1901.          MOV SI,AX             { Save X in SI - SI is the only
  1902.                                  Free register and it's faster than
  1903.                                  a PUSH }
  1904.  
  1905.          PUSH BX
  1906.          PUSH CX
  1907.  
  1908.          CALL FPutPixel        { Plot pixel at AX,BX. }
  1909.  
  1910.          POP CX
  1911.          POP BX
  1912.          MOV AX,SI             { Restore X coord }
  1913.  
  1914. @NoPlot:
  1915.          SHL CL,1              { Shift char byte left }
  1916.          INC AX                { Adjust X }
  1917.  
  1918.          DEC DH                { Reduce horizontal count }
  1919.          JNZ @PlotLoop         { If not 0, go to plot loop }
  1920.  
  1921.          MOV AX,BP
  1922.  
  1923.  
  1924.  
  1925.  
  1926. @RestoreByteOffset:
  1927.          INC DI                { move to next byte }
  1928.  
  1929.          DEC CH                { Reduce byte count }
  1930.          JNZ @OuterLoop
  1931.  
  1932.          POP CX                { Restore vert count }
  1933.  
  1934.          INC BX                { Add 1 to Y, assuming Y is not more
  1935.                                  than 255. Do NOT use BL to gain more
  1936.                                  speed! unexpected side effects will
  1937.                                  occur when writing text at the top of
  1938.                                  your screen }
  1939.          DEC CH                { Reduce vert count }
  1940.  
  1941.          JNZ @ScanLineLoop
  1942.  
  1943.  
  1944. {
  1945. Now is the time to update the graphics cursor after the single
  1946. character has been printed.
  1947. }
  1948.  
  1949.          MOV AL,CurrentFontWidth
  1950.          XOR AH,AH                   { Make AH 0 }
  1951.          ADD CursorX,AX              { Update the graphics cursor }
  1952.  
  1953.          POP CX                { Restore width. Wish there were more
  1954.                                  data registers to work with but there
  1955.                                  aren't and it's a bad situation really }
  1956.          POP DI                { Restore next char to print's offset }
  1957.  
  1958.          DEC CL                { Reduce char length counter }
  1959.          JNZ @ReadChar
  1960.  
  1961.          POP BP
  1962.  
  1963. @NoWrite:
  1964. End;
  1965.  
  1966.  
  1967.  
  1968.  
  1969.  
  1970.  
  1971.  
  1972.  
  1973. {
  1974. Display a string of text at the current cursor position, using
  1975. the current Font.
  1976.  
  1977. Expects : Txt is the text to write at the current cursor position.
  1978.  
  1979. Returns : Graphics cursor has moved.
  1980.  
  1981. Corrupts : See OutTextXY.
  1982. }
  1983.  
  1984. Procedure OutText(txt:string);
  1985. Begin
  1986.      OutTextXY(CursorX,CursorY,txt);
  1987. End;
  1988.